SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00009 CHARACTER HANDLING 1 05-28-9313:33ALL SWAG SUPPORT TEAM Manipulating the VGA FontIMPORT 18 {πDAVID DRZYZGAππ> Is there any way to create or use your own fonts inπ> regular Text mode With Pascal?ππHere's a demo of a routine originally posted by Bernie P and revised by me:π}ππProgram UpsideDown;π{-upsidedown and backwards Text aka redefining the Text mode font}πVarπ newCharset,π oldCharset : Array[0..255,1..16] of Byte;ππProcedure getoldCharset;πVarπ b : Byte;π w : Word;πbeginπ For b := 0 to 255 doπ beginπ w := b * 32;π Inline($FA);π PortW[$3C4] := $0402;π PortW[$3C4] := $0704;π PortW[$3CE] := $0204;π PortW[$3CE] := $0005;π PortW[$3CE] := $0006;π Move(Ptr($A000, w)^, oldCharset[b, 1], 16);π PortW[$3C4] := $0302;π PortW[$3C4] := $0304;π PortW[$3CE] := $0004;π PortW[$3CE] := $1005;π PortW[$3CE] := $0E06;π Inline($FB);π end;πend;ππProcedure restoreoldCharset;πVarπ b : Byte;π w : Word;πbeginπ For b := 0 to 255 doπ beginπ w := b * 32;π Inline($FA);π PortW[$3C4] := $0402;π PortW[$3C4] := $0704;π PortW[$3CE] := $0204;π PortW[$3CE] := $0005;π PortW[$3CE] := $0006;π Move(oldCharset[b, 1], Ptr($A000, w)^, 16);π PortW[$3C4] := $0302;π PortW[$3C4] := $0304;π PortW[$3CE] := $0004;π PortW[$3CE] := $1005;π PortW[$3CE] := $0E06;π Inline($FB);π end;πend;ππProcedure setasciiChar(Charnum : Byte; Var data);πVarπ offset : Word;πbeginπ offset := CharNum * 32;π Inline($FA);π PortW[$3C4] := $0402;π PortW[$3C4] := $0704;π PortW[$3CE] := $0204;π PortW[$3CE] := $0005;π PortW[$3CE] := $0006;π Move(data, Ptr($A000, offset)^, 16);π PortW[$3C4] := $0302;π PortW[$3C4] := $0304;π PortW[$3CE] := $0004;π PortW[$3CE] := $1005;π PortW[$3CE] := $0E06;π Inline($FB);πend;ππProcedure newWriteln(s : String);π {- Reverses order of Characters written}πVarπ b : Byte;πbeginπ For b := length(s) downto 1 doπ Write(s[b]);π Writeln;πend;ππVarπ b, c : Byte;ππbeginπ getoldCharset;π For b := 0 to 255 doπ For c := 1 to 16 doπ newCharset[b, c] := oldCharset[b, (17 - c)];π For b := 0 to 255 doπ setasciiChar(b, newCharset[b, 1]);π newWriteln('Hello World!');π readln;π restoreoldCharset;πend.π 2 05-28-9313:33ALL SWAG SUPPORT TEAM Character Case IMPORT 23 {πBO BendTSENππ Upper/lower changing of Strings are always a difficult problem,π but as a person living in Denmark i must normally care aboutπ danish Characters, i know a lot of developers does not care aboutπ international Character and just use the normal UPCASE routines.π I advise you to use these routines or make some that has theπ same effect, so we will not have any problems when searching forπ uppercased Strings.ππ Made available to everyone 1993 by Bo Bendtsen 2:231/111 +4542643827ππ Lowcase Upper/high/capital lettersπ Æπ ¢ ¥π å Åπ ä Äπ ç Çπ é Éπ ö Öπ ñ Ñπ ü Üππ}ππFunction UpChar(Ch : Char) : Char;π{ Uppercase a Char }πbeginπ If Ord(Ch) In [97..122] Then Ch := Chr(Ord(Ch) - 32)π Else If Ord(Ch) > 90 Thenπ If Ch='' Then Ch:='Æ'π Else If Ch='¢' Then Ch:='¥' Else If Ch='å' Then Ch:='Å'π Else If Ch='ä' Then Ch:='Ä' Else If Ch='ç' Then Ch:='Ç'π Else If Ch='é' Then Ch:='É' Else If Ch='ö' Then Ch:='Ö'π Else If Ch='ñ' Then Ch:='Ñ' Else If Ch='ü' Then Ch:='Ü';π UpChar:=Ch;πend;ππFunction StUpCase(S : String) : String;π{ Uppercase a String }πVarπ SLen : Byte Absolute S;π x : Integer;πbeginπ For x := 1 To SLen Do S[x]:=UpChar(S[x]);π StUpCase := S;πend;ππFunction LowChar(Ch : Char) : Char;π{ lowercase a Char }πbeginπ If Ord(Ch) In [65..90] Then Ch := Chr(Ord(Ch) + 32)π Else If Ord(Ch) > 122 Thenπ If Ch='Æ' Then Ch := ' 'π Else If Ch='¥' Then Ch:='¢' Else If Ch='Å' Then Ch:='å'π Else If Ch='Ä' Then Ch:='ä' Else If Ch='Ç' Then Ch:='ç'π Else If Ch='É' Then Ch:='é' Else If Ch='Ö' Then Ch:='ö'π Else If Ch='Ñ' Then Ch:='ñ' Else If Ch='Ü' Then Ch:='ü';π LowChar := Ch;πend;ππFunction StLowCase(S : String) : String;π{ Lowercase a String }πVarπ SLen : Byte Absolute S;π i : Integer;πbeginπ For i := 1 To SLen Do S[i]:=LowChar(S[i]);π StLowCase := S;πend;ππFunction StToggleCase(S : String) : String;π{ lower = upper and upper = lower }πVarπ SLen : Byte Absolute S;π i : Integer;πbeginπ For i := 1 To SLen Doπ beginπ If Ord(S[i]) In [65..90] Then S[i] := Chr(Ord(S[i]) + 32)π Else If Ord(S[i]) In [97..122] Then S[i] := Chr(Ord(S[i]) - 32)π Else If Pos(S[i],'¢åäçéöñü') <> 0 Then S[i]:=UpChar(S[i])π Else If Pos(S[i],'ÆÅ¥ÇÄÖÉÜÑ')<> 0 Then S[i]:=LowChar(S[i]);π end;π StToggleCase := S;πend;ππFunction StSmartCase(S : String) : String;π{ bO bEnDTSen will be converted into : Bo Bendtsen }πVarπ SLen : Byte Absolute S;π i : Integer;πbeginπ s:=StLowCase(s);π For i := 1 To SLen Doπ beginπ If i=1 Then S[1]:=UpChar(S[1])π Else if S[i-1]=' ' Then S[i]:=UpChar(S[i])π Else if (Ord(S[i-1]) In [32..64]) And (S[i-1]<>'''') ThenπS[i]:=UpChar(S[i]);π end;π StSmartCase := S;πend;π 3 05-28-9313:33ALL SWAG SUPPORT TEAM Switch Font Characters IMPORT 27 {π> How can I redefine the ASCII Chars. For example how canπ> I make the ASCII code 65 become a "weird form" insteadπ> of an "A".ππYou want it, you got it. Here are the two Procedures you need, plus someπinfo. First, you need to make a data Type With an Array of [1..16] of Byte,πso the best idea would be this: Make a Record as follows:π}ππTypeπ CharRec = Recordπ data : Array[1..16] of Byte;π end;ππ{ Now, make a Variable to contain the entire Character set. }ππVarπ CharSet : Array[0..255] of CharRec;ππ{ Next, you'll need the two Procedures: }ππProcedure GetImageChar(chrVal : Byte; Var CharInfo);πVarπ offset : Word;πbeginπ offset := chrVal * 32;π Inline($FA);π PortW[$3C4] := $0402;π PortW[$3C4] := $0704;π PortW[$3CE] := $0204;π PortW[$3CE] := $0005;π PortW[$3CE] := $0006;π (* refer to following notes For info about the next line *)π Move(Ptr($A000, offset)^, CharInfo, 16);π PortW[$3C4] := $0302;π PortW[$3C4] := $0304;π PortW[$3CE] := $0004;π PortW[$3CE] := $1005;π PortW[$3CE] := $0E06;π Inline($FB);πend;ππ{πOK. That's the Procedure to GET a Character bitmap, and store it in aπVariable. So, if you use the Type and Var I defined at the top, do this:ππGetImageChar(65, CharSet[65]);ππThis example will copy the bitmap from Character 65 (A) into the Record of 65,πso you'll have copied the bitmap For 'A'. Now, you can edit the bitmap (Iπwrote my own font editor) and Write it to memory With a second Procedure.ππHere's the tricky part. I didn't Write the 2nd Procedure because it isπidentical to the first *EXCEPT* For ONE line. Copy the Procedure and changeπit's name to SetImageChar, and change this line:ππMove(Ptr($A000, offset)^, CharInfo, 16);ππand make it read:ππMove(CharInfo, Ptr($A000, offset)^, 16);ππThat's it! Have fun! TTYL.π}ππ{πOK, 'data' is an Array [1..16] of Byte. So, you just draw your Character onπGraph paper in binary, convert to decimal Bytes, put them in the Array, andπfeed it into this Procedure. 'CharNum' is the ASCII value of the Character youπwant to remap. To make a Procedure that READS the bitmap instead of writing,πjust change the line With 'Move(data, Ptr($A000, offset)^, 16)' and make it sayπ'Move(Ptr($A000, offset)^, data, 16);' and you will now be able to read bitmapsπfrom the Character set. I'm running out of time, so I can't explain it veryπwell, but I hope this helps. TTYL.π}π{ππ I ran that in a loop and after a While it screwed up the wholeπ font - might just be my EGA card, but my opinion is that thisπ method stinks...there are Registers For getting/setting theπ font; I found code from a Program called Display Font Editorπ (DFE). DFE edits font Files, and it came With source toπ load these font Files. Following is a bit from settingπ the Registers to load a font (don't have getting a font)ππ r.ax := $1110;π r.bh := 14; (* Bytes per Character *)π r.bl := 0; (* load to block 0 *)π r.cx := 256; (* 256 Characters *)π r.dx := 0; (* start With Character 0 *)π r.es := Seg(P^); (* segment of table *)π r.bp := Ofs(P^); (* offset of the table *)π intr($10, r);ππ With this, you can see, you can even do one Character at aπ time ( cx = 1, dx = ascii, P^ = Array[1..14] of Byte)π} 4 05-28-9313:33ALL SWAG SUPPORT TEAM Read Screen CHARS IMPORT 5 {πAuthor: A A OlowofoyekuππAs For reading the ASCII stuff from the screen, I have a routine thatπallows you to read a Character from any location on the screen.π}ππUsesπ Dos;ππ{-- read the Character at the cursor and return it as a Char --}πFunction ScreenChar : Char;πVarπ R : Registers;πbeginπ FillChar(R, SizeOf(R), 0);π R.AH := 8;π R.BH := 0;π Intr($10, R);π ScreenChar := Chr(R.AL);πend;π 5 05-28-9313:33ALL SWAG SUPPORT TEAM Redefine FONT Chars IMPORT 22 {π>> I know this can be done - in fact I've seen posts on it before, but itπ>> didn't strike me as something to save at the time. . .π> Does anyone know how to redefine the Characters used in Text mode? Iπ>> don't want to use a whole new set; rather I'd like to change just about aπ>> dozen or so Characters to my own.ππThis is a little routine I developed sometime ago to redefine some of theπascii Chars as 'smileys'. The Arrays of hex values are Characterπbitmaps. There is a rather good article about doing this sort of thing in PCπMagazine,Volume 9 number 2 (Jan 30, 1990)π}ππProgram Redefine;ππUsesπ Dos,Crt;ππProcedure loadChar;πConstπ numnewChars = 6;πTypeπ ByteArray = Array[0..15] of Byte;π CharArray = Array[1..numnewChars] of Recordπ CharNum : Byte;π CharData : ByteArray;π end;ππConst newChars : CharArray = (π (CharNum : 21;π CharData : ($00,$00,$E7,$A5,$E7,$00,$00,$08,$18,$38,$00,$00,$C3,$C3,$7E,$00)),π (Charnum : 4;π CharData : ($00,$00,$E7,$A5,$E7,$00,$00,$08,$18,$38,$00,$00,$7E,$C3,$C3,$00)),π (Charnum : 19;π CharData : ($AA,$AA,$FE,$00,$EE,$AA,$EE,$00,$08,$18,$38,$00,$C6,$C6,$7C,$00)),π (Charnum : 17;π CharData : ($03,$07,$FF,$00,$0E,$0A,$0E,$00,$00,$01,$03,$00,$08,$07,$00,$00)),π (Charnum : 23;π CharData : ($C0,$E0,$FF,$00,$E0,$A0,$E0,$00,$80,$80,$80,$10,$10,$E0,$00,$00)),π (Charnum : 24;π CharData : ($E7,$42,$00,$C3,$A5,$E7,$00,$08,$18,$38,$00,$00,$7E,$FF,$81,$00))π );ππVarπ r : Registers;π i : Byte;ππbeginπfor i := 1 to numnewChars doπ With r doπ beginπ ah := $11; { video sub-Function $11 }π al := $0; { Load Chars to table }π bh := $10; { number of Bytes per Char }π bl := 0; { Character table to edit }π cx := 1; { number of Chars we're definig }π dx := NewChars[i].CharNum; { ascii value of the Char }π es := seg(NewChars[i].CharData); { es:bp --> table we're loading }π bp := ofs(NewChars[i].CharData);π intr($10,r);π end;πend;ππbeginπ loadChar;π Writeln('Char(21) is now ',chr(21));Writeln;π Writeln('Char(04) is now ',chr(04));Writeln;π Writeln('Char(19) is now ',chr(19));Writeln;π Writeln('Char(17) is now ',chr(17));Writeln;π Writeln('Char(23) is now ',chr(23));Writeln;π Writeln('Char(24) is now ',chr(24));Writeln;π readln;π Textmode(co80);π Writeln('Char(21) is now ',chr(21));Writeln;π Writeln('Char(04) is now ',chr(04));Writeln;π Writeln('Char(19) is now ',chr(19));Writeln;π Writeln('Char(17) is now ',chr(17));Writeln;π Writeln('Char(23) is now ',chr(23));Writeln;π Writeln('Char(24) is now ',chr(24));Writeln;πend.π 6 11-26-9318:05ALL MICHAEL HOENIE Change VGA/EGA/CGA Fonts SWAG9311 27 ▐N {πFrom: MICHAEL HOENIEπSubj: CHARACTER UNIT.π----------------------------------------------------------------------πhere is some revised code to allow users to change the standard ASCIIπfont in EGA or VGA. I don't know if it will work in standard CGA, butπit works well on VGA. }ππ unit graphics;ππ interface uses dos, crt;ππ constπ numnewchars=9; { # of chars available }ππ {1 2 4 8 1 3 6 1π │ │ │ │ 6 2 4 2π │ │ │ │ │ │ │ 8π │ │ │ │ │ │ │ │ Character.π 1 2 3 4 5 6 7 8 8x16π ┌─┬─┬─┬─┬─┬─┬─┬─┐π 1│ │ │ │ │ │ │ │ │=π 2│ │ │ │ │ │ │ │ │= This is a BYTE mapper.π 3│ │ │ │ │ │ │ │ │= Fill in the blanks, then addπ 4│ │ │ │ │ │ │ │ │= the numbers together on a calculator.π 5│ │ │ │ │ │ │ │ │= The # should never be greater than 255.π 6│ │ │ │ │ │ │ │ │=π 7│ │ │ │ │ │ │ │ │= The #'s are as follows:π 8│ │ │ │ │ │ │ │ │=π 9│ │ │ │ │ │ │ │ │= 1,2,4,8,16,32,64,128π 10│ │ │ │ │ │ │ │ │=π 11│ │ │ │ │ │ │ │ │= So if you had:π 12│ │ │ │ │ │ │ │ │=π 13│ │ │ │ │ │ │ │ │= X X X X X Xπ 14│ │ │ │ │ │ │ │ │= 1 2 4 16 32 128 = 183π 15│ │ │ │ │ │ │ │ │=π 16│ │ │ │ │ │ │ │ │=π └─┴─┴─┴─┴─┴─┴─┴─┘}ππ procedure loadchar; { this is the procedure to change the characters }ππ implementationππ procedure loadchar;π typeπ bytearray=array[0..15] of byte;π chararray=array[1..numnewchars] of recordπ charnum:byte;π chardata:bytearray;π end;π const { these are the characters outlined 9 = chr(9), 176 = chr(176) }π newchars:chararray=(π (charnum:9; chardata: (24,0,66,0,0,024,165,24,60,102,66,66,66,π 102,60,0)),π (charnum:10; chardata: (24,126,255,231,231,255,255,255,255,255,π 191,255,255,255,255,255)),π (charnum:24; chardata: (24,24,24,24,24,24,24,24,24,24,126,24,24,π 24,60,24)),π (charnum:231; chardata: (8,42,28,127,27,42,8,8,8,8,8,8,8,8,8,0)),π (charnum:235; chardata: (0,0,102,60,24,24,24,60,60,126,126,126,π 60,24,0,0)),π (charnum:239; chardata: (255,171,213,171,213,171,213,171,213,171,π 213,171,213,171,213,171)),π (charnum:225; chardata: (24,60,102,102,102,60,24,24,24,24,120,120,π 24,120,120,0)),π (charnum:176; chardata: (9,64,4,33,0,136,2,32,1,136,0,66,0,8,64,18)),π (charnum:177; chardata: (119,119,119,0,238,238,238,0,119,119,119,0,π 238,238,238,0)));ππ varπ regs:registers;π i:byte;π beginπ for i:=1 to numnewchars doπ beginπ with regs doπ beginπ ah:=$11; { video sub-Function $11 }π al:=$0; { Load Chars to table $1 }π bh:=$10; { number of Bytes per Char $10 }π bl:=0; { Character table to edit }π cx:=1; { number of Chars we're definig }π dx:=newchars[i].charnum;π es:=seg(newchars[i].chardata);π bp:=ofs(newchars[i].chardata);π intr($10,regs);π end;π end;π end;ππ beginπ end.π 7 11-26-9318:06ALL RICHARD WILTON Reverse EGA/VGA Fonts SWAG9311 26 ▐N program Reverse;ππ{π Sample program demonstrating manipulation of the VGA (EGA?)π alphanumeric character set using the 80x25 character mode.ππ The only thing this program does is to copy the current characterπ set from the video adapter, and restore it in such a way that allπ the characters appear upside-down. To restore the characters,π simply run the program again. Not that this is a terribly usefulπ thing to do, mind you...ππ NOTE: This has not been tested on monochrome monitors or inπ other video modes.ππ Written using Borland Pascal 7.0.ππ For more information on character sets for other video modes andπ a whole bunch of good stuff on the EGA & VGA in general, you willπ want the following book:ππ Title - "Programmer's Guide to PC & PS/2 Video Systems"π Author - Richard Wilton, 1987π Publisher - Microsoft Pressπ 16011 NE 36th Wayπ Box 97017π Redmond, Washington 98073-9717π}ππ varπ I, J: integer;π CBuf: array [0..8191] of byte; { Buffer for original character map }πππ procedure CharGenModeOn;ππ { I'm sorry that there is no explanation here, but I did this a whileπ ago and I don't have the reference with me right now. }ππ beginπ asmπ cliπ mov dx,03C4hπ mov ax,0100hπ out dx,axπ mov ax,0402hπ out dx,axπ mov ax,0704hπ out dx,axπ mov ax,0300hπ out dx,axπ stiπ mov dl,0CEhπ mov ax,0204hπ out dx,axπ mov ax,0005hπ out dx,axπ mov ax,0006hπ out dx,axπ end;π end;πππ procedure CharGenModeOff;ππ beginπ asmπ cliπ mov dx,03C4hπ mov ax,0100hπ out dx,axπ mov ax,0302hπ out dx,axπ mov ax,0304hπ out dx,axπ mov ax,0300hπ out dx,axπ stiπ mov dl,0CEhπ mov ax,0004hπ out dx,axπ mov ax,1005hπ out dx,axπ mov ax,0E06hπ out dx,axπ mov ah,0Fhπ int 10hπ cmp al,7π jne @skipπ mov ax,0806hπ out dx,axπ @skip:π end;π end;πππ beginπ CharGenModeOn; { Get access to character map }ππ { Copy the current character map into the buffer }π move( mem[$A000: 0], CBuf, 8192 );ππ { Restore the map, inverting the top 16 scan lines.ππ Characters are stored in a 8x32 pixel matrix, allowingπ for characters that are 32 scan lines high. Each byteπ in the buffer represents one scan line of a singleπ character. In the 80x25 character mode only the firstπ 16 scan lines are displayed, so we need to be a littleπ careful about what bytes are swapped. }ππ for I := 0 to 255 do { Each of the 256 characters }π for J := 0 to 15 do { Top 16 scan lines of each }π mem[$a000:((I*32) + J)] := CBuf[(I*32) + (15 - J)];ππ CharGenModeOff; { Restore normal video operations }π end.π 8 11-26-9318:05ALL SEAN PALMER Text Fonts in ASM SWAG9311 9 ▐N {πFrom: SEAN PALMERπSubj: Text Fonts in ASMπ}ππProcedure SetAsciiChar(Charnum : Word; Var Data); Assembler;πASMπ mov ah,11hπ mov al,10hπ mov bh,10hπ mov bl,0π mov cx,1 {set 1 character only}π mov dx,charnum {what charnum to modify }π mov bp,seg data {seg of the char}π mov es,bpπ mov bp,offset data {ofs of the char}π int 10hπEnd;ππ{πThis has been reputed to work. Although I didn't write it (Salim SamharaπI think is who did) and if I did I would have changed it to load ax andπbx as one unit instead of ah and al, then bh and bl. With this thoughπyou have to have the buffer in the data segment, not on the stack.ππSo here's how I would do it:π}ππProcedure LoadFont (FileName : String);πTypeπ FontType=Array [char] of Array [0..15] of Byte;πVarπ F : File of FontType;π Font : FontType;πBeginπ Assign (F, FileName);π Reset (F);π Read (F,Font);π Close (F);π Asmπ mov ax,$1100π mov bx,$1000π mov cx,$0100π xor dx,dxπ mov es,seg Fontπ mov bp,offset Fontπ Int $10π end;π End;π 9 11-26-9318:05ALL SWAG SUPPORT TEAM Font Library for Text SWAG9311 38 ▐N {πUser font library for text mode.π}πππ{$IFDEF DPMI}π{$X+,S-}π{$ELSE}π{$X+,F+,O+}π{$ENDIF}πunit BBFont;ππinterfaceππconstπ FontHeight = 16; { 14 for EGA mode }ππtypeπ PCharShape = ^TCharShape;π TCharShape = array[0..FontHeight-1] of byte;ππvarπ points : word;πππprocedure ReplaceChar(c : char; NewChar : PCharShape);πππimplementationπππ{*******************************************************************}π{ Wen 03-mrt-1993 - wvl }π{ }π{ Get font block index of current (resident) and alternate }π{ character set. Up to two fonts can be active at the same time }π{ }π{*******************************************************************}ππTypeπ FontBlock = 0..7;πππProcedure GetFontBlock(Var primary, secondary : FontBlock); Assembler;ππASMπ { Get character map select register:π (VGA sequencer port 3C4h/3C5h index 3)ππ 7 6 5 4 3 2 1 0π 3 3 3 3 3 3π 3 3 3 3 @DDADD Primary font (lower 2 bits)π 3 3 @DDADDDDDDDD Secondary font (lower 2 bits)π 3 @DDDDDDDDDDDDDD Primary font (high bit)π @DDDDDDDDDDDDDDDDD Secondary font (high bit) }ππ MOV AL, 3π MOV DX, 3C4hπ OUT DX, ALπ INC DXπ IN AL, DXπ MOV BL, ALπ PUSH AXππ { Get secondary font number: add up bits 5, 3 and 2 }ππ SHR AL, 1π SHR AL, 1π AND AL, 3π TEST BL, 00100000bπ JZ @1π ADD AL, 4π@1: LES DI, secondaryπ STOSBππ { Get primary font number: add up bits 4, 1 and 0 }ππ POP AXπ AND AL, 3π TEST BL, 00010000bπ JZ @2π ADD AL, 4π@2: LES DI, primaryπ STOSBπend; { GetFontBlock }ππππfunction postinc(var w : word) : word; assembler;πasmπ les di,wπ mov ax,word ptr es:[di]π inc word ptr es:[di]πend;π{* pascal codeπbeginπ postinc := w;π inc(w);πend;π*}πππprocedure ReplaceChar(c : char; NewChar : PCharShape);πvarπ i : integer;π off : word;π CharPos : word;π primfont, secfont : FontBlock;π base : word;πbeginππ{* program the VGA controller *}π asmπ pushf { Disable interrupts }π cliπ mov dx, 03c4h { Sequencer port address }π mov ax, 0704h { Sequential addressing }π out dx, axπ mov dx, 03ceh { Graphics Controller port address }π mov ax, 0204h { Select map 2 for CPU reads }π out dx, axπ mov ax, 0005h { Disable odd-even addressing }π out dx, axπ mov ax, 0406h { Map starts at A000:0000 (64K mode) }π out dx, axπ mov dx, 03c4h { Sequencer port address }π mov ax, 0402h { CPU writes only to map 2 }π out dx, axπ end;ππ{ first get the current font *}π GetFontBlock(primfont, secfont);π base := 8192*primfont;ππ off := 16 - points;ππ CharPos := Ord(c) * 32;ππ for i := 0 to points-1 do beginπ mem[SegA000:base+postinc(CharPos)] := NewChar^[postinc(off)];π end;ππ{ Ok, put the Sequencer and Graphics Controller back to normal }ππ asmππ { Program the Sequencer }π pushf { Disable interrupts }π cliπ mov dx, 3c4h { Sequencer port address }π mov ax, 0302h { CPU writes to maps 0 and 1 }π out dx, axπ mov ax, 0304h { Odd-even addressing }π out dx, axππ { Program the Graphics Controller }π mov dx, 3ceh { Graphics Controller port address }π mov ax, 0004h { Select map 0 for CPU reads }π out dx, axπ mov ax, 1005h { Enable odd-even addressing }π out dx, ax;π mov ax,Seg0040π mov es,axπ mov ax, 0e06h { Map starts at B800:0000 }π mov bl, 7π cmp es:[49h], bl { Get current video mode }π jne @@notmonoπ mov ax, 0806h { Map starts at B000:0000 }π@@notmono:π out dx, ax;π popf;π end;πend;πππbeginπ if (Mem[Seg0040:$0084] = 0)π then points := 8π else beginπ if Mem[Seg0040:$0084] in [42,49]π then points := 13π else points := Mem[Seg0040:$0085];π end;πend. { of unit BBFont }ππππprogram Test;ππuses BBFont,...;ππprocedure TestFont;πconstπ NewA:TCharShape = (π $FF, {11111111}π $00, {00000000}π $FF, {11111111}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00, {00000000}π $00 {00000000}π );πbeginπ ReplaceChar('A', @NewA);πend;πππbeginπ TestFont;πend.πππ
